﻿module AstPrintForm

open System.Drawing
open System.Windows.Forms
open Ast

type TreeNodeCollection with
  member this.AddRange (elems:TreeNode list) = this.AddRange(Seq.toArray elems)
  member this.AddRange (elems:string list) = this.AddRange(List.map (fun el -> TreeNode(el)) elems)

//let rec stringListToTreeNodesList l : TreeNode list =
//  match l with
//  | [] -> []
//  | x::xs -> (TreeNode(x))::(stringListToTreeNodesList xs)

let rec TypeToString = 
  function
  | Type.Boolean -> "bool"
  | Type.Integer -> "int"
  | Type.String -> "string"
  | Type.Identifier name -> name
  | Type.Array ty -> (TypeToString ty) + "[]"

//let ReturnTypeToString ty =
//  match ty with
//  | Void -> "Void"
//  | Type ty -> TypeToString ty

let BinaryToString =
  function
  | Binary.Sum _ -> "+"
  | Binary.Minus -> "-"
  | Binary.Mul -> "*"
  | Binary.Div -> "/"
  | Binary.Mod -> "%"
  | Binary.And -> "&&"
  | Binary.Or -> "||"
  | Binary.Min -> "<"
  | Binary.MinEq -> "<="
  | Binary.Greater -> ">"
  | Binary.GreaterEq -> ">="
  | Binary.Eq -> "=="
  | Binary.NotEq -> "!="

let UnaryToString = 
  function
  | Unary.Negative -> "-"
  | Unary.Not -> "!"

let LitteralToString =
  function
  | Int i -> string i
  | Str s -> s
  | Bool b -> string b
  | Null -> "null"

let rec ProgramToTreeNode prog name =
  let node = TreeNode("Program " + name)
  do node.Nodes.AddRange(prog |> List.map (fun cd -> ClassDeclToTreeNode cd))
  node

and ClassDeclToTreeNode (c:ClassDecl) =
  let (ClassDecl.ClassDecl(name, extension, body)) = c
  let node = TreeNode("Class " + name)
  do match extension with
      | None -> ()
      | Some ext -> node.Nodes.Add("extends " + ext) |> ignore
  do node.Nodes.AddRange(body |> List.map (fun fmd -> FieldOrMethodDeclToTreeNode fmd))
  node

and FieldOrMethodDeclToTreeNode (fmd:FieldOrMethodDecl) = 
  match fmd with
  | FieldOrMethodDecl.FieldDecl (ty, name, others, _) ->
    let node = TreeNode("FieldOrMethodDecl.FieldDecl")
    do node.Nodes.Add(TypeToString ty) |> ignore
    do node.Nodes.AddRange(name::others)
    node
  | FieldOrMethodDecl.MethodDecl (ty, name, args, block, _) -> 
      let node = TreeNode("FieldOrMethodDecl.MethodDecl")
      do node.Nodes.Add(ReturnTypeToTreeNode ty) |> ignore
      do node.Nodes.Add("Name : " + name) |> ignore
      do node.Nodes.AddRange(args |> List.map (fun arg -> ArgToTreeNode arg))
      do node.Nodes.Add(BlockToTreeNode(block)) |> ignore
      node

and ReturnTypeToTreeNode ty : TreeNode =
  match ty with
  | ReturnType.Void -> 
    TreeNode("ReturnType.Void")
  | ReturnType.Type ty -> 
    let node = TreeNode("ReturnType.Type")
    do node.Nodes.Add(TypeToTreeNode ty) |> ignore
    node

and TypeToTreeNode (ty : Type) : TreeNode = 
  match ty with
  | Type.Boolean -> TreeNode("Type.bool")
  | Type.Integer -> TreeNode("Type.int")
  | Type.String -> TreeNode("Type.string")
  | Type.Identifier name -> TreeNode("Type : " + name)
  | Type.Array ty -> TreeNode("Type : " + (TypeToString ty) + "[]")

and ArgToTreeNode arg =
  let (Arg(ty, name)) = arg
  let node = TreeNode("Arg")
  do node.Nodes.Add(TypeToString ty) |> ignore
  do node.Nodes.Add(name) |> ignore
  node

and BlockToTreeNode block : TreeNode =
  let (Block.Block(varDecls, statements, _)) = block
  let node = TreeNode("Block")
  do node.Nodes.AddRange(varDecls |> List.map (fun vd -> VarDeclToTreeNode vd))
  do node.Nodes.AddRange(statements |> List.map (fun stmt -> StmtToTreeNode stmt))
  node

and VarDeclToTreeNode vd =
  let (VarDecl(ty, first, others, _)) = vd
  let node = TreeNode("VarDeclaration")
  do node.Nodes.Add(TypeToTreeNode ty) |> ignore
  do node.Nodes.Add(id_assignmentToTreeNode first) |> ignore
  do node.Nodes.AddRange(others |> List.map (fun idAss -> id_assignmentToTreeNode idAss)) |> ignore
  node

and StmtToTreeNode stmt =
  match stmt with
  | Stmt.Assign (location, expr, _) -> 
    let node = TreeNode("Stmt.Assign")
    do node.Nodes.Add(LocationToTreeNode location) |> ignore
    do node.Nodes.Add(ExprToTreeNode expr) |> ignore
    node
  | Stmt.Call (call, _) ->
    let node = TreeNode("Stmt.Call")
    let call_n : TreeNode = CallToTreeNode call
    do node.Nodes.Add(call_n) |> ignore
    node  
  | Stmt.Return (None, _) ->
    TreeNode("Stmt.Return of Void")
  | Stmt.Return (Some expr, _) ->
    let node = TreeNode("Stmt.Return")
    do node.Nodes.Add(ExprToTreeNode expr) |> ignore
    node
  | Stmt.If (expr, stmt, None, _) ->
    let node = TreeNode("Stmt.If")
    do node.Nodes.Add(ExprToTreeNode expr) |> ignore
    do node.Nodes.Add(StmtToTreeNode stmt) |> ignore
    node
  | Stmt.If (expr, stmt, (Some elseStmt), _) ->
    let node = TreeNode("Stmt.If and Else")
    do node.Nodes.Add(ExprToTreeNode expr) |> ignore
    do node.Nodes.Add(StmtToTreeNode stmt) |> ignore
    do node.Nodes.Add(StmtToTreeNode elseStmt) |> ignore
    node
  | Stmt.While (expr, stmt, _) ->
    let node = TreeNode("Stmt.While")
    do node.Nodes.Add(ExprToTreeNode expr) |> ignore
    do node.Nodes.Add(StmtToTreeNode stmt) |> ignore
    node
  | Stmt.Block block -> 
    let node = TreeNode("Stmt.Block")
    do node.Nodes.Add(BlockToTreeNode block) |> ignore
    node
  | Stmt.Break _ -> TreeNode("Stmt.Break")
  | Stmt.Continue _ -> TreeNode("Stmt.Continue")

and LocationToTreeNode loc : TreeNode =
  match loc with
  | Location.Id name -> TreeNode("Location.Id : " + name)
  | Location.Member (expr, name, _) -> 
    let node = TreeNode("Location.Member")
    do node.Nodes.Add(ExprToTreeNode expr) |> ignore
    do node.Nodes.Add(name) |> ignore
    node
  | Location.Nth (source, elem) ->
    let node = TreeNode("Location.Nth")
    do node.Nodes.Add(ExprToTreeNode source) |> ignore
    do node.Nodes.Add(ExprToTreeNode elem) |> ignore
    node
    
and CallToTreeNode call =
  let (Call.Call(meth, parameters)) = call
  let node = TreeNode("Call")
  do node.Nodes.Add(MethodToTreeNode meth) |> ignore
  do node.Nodes.AddRange(parameters |> List.map (fun expr -> ExprToTreeNode expr)) |> ignore
  node

and MethodToTreeNode meth : TreeNode =
  match meth with
  | Method.Method name -> TreeNode(name)
  | Method.Select (expr, name, _) -> 
    let node = TreeNode("Select")
    do node.Nodes.Add(ExprToTreeNode expr) |> ignore
    do node.Nodes.Add(name) |> ignore
    node

and id_assignmentToTreeNode idAss : TreeNode =
  match idAss with
  | (name,None) ->
    TreeNode(name)
  | (name,Some(expr)) ->
    let node = TreeNode(name)
    do node.Nodes.Add(ExprToTreeNode expr) |> ignore
    node

and ExprToTreeNode expr : TreeNode = 
  match expr with
  | Expr.Location location ->
    let node = TreeNode("Expr.Location")
    do node.Nodes.Add(LocationToTreeNode location) |> ignore
    node    
  | Expr.Call call ->
    let node = TreeNode("Expr.Call")
    do node.Nodes.Add(CallToTreeNode call) |> ignore
    node
  | Expr.New name ->
    TreeNode("Expr.New " + name)
  | Expr.NewArray (ty, expr) ->
    let node = TreeNode("Expr.NewArray")
    do node.Nodes.Add(TypeToTreeNode ty) |> ignore
    do node.Nodes.Add(ExprToTreeNode expr) |> ignore
    node
  | Expr.Length expr ->
    let node = TreeNode("Expr.Length")
    do node.Nodes.Add(ExprToTreeNode expr) |> ignore
    node
  | Expr.Binary (left, op, right) ->
    let node = TreeNode("Expr.Binary " + BinaryToString op)
    do node.Nodes.Add(ExprToTreeNode left) |> ignore
    do node.Nodes.Add(ExprToTreeNode right) |> ignore
    node
  | Expr.Unary (op, expr) ->
    let node = TreeNode("Expr.Unary " + UnaryToString op)
    do node.Nodes.Add(ExprToTreeNode expr) |> ignore
    node
  | Expr.Literal lit ->
    TreeNode("Expr.Literal : " + LitteralToString lit)
  | Expr.This -> 
    TreeNode("Expr.This")

and LitteralToTreeNode lit : TreeNode =
  match lit with
  | Literal.Int i ->
    TreeNode(string i)
  | Literal.Str s ->
    TreeNode(s)
  | Literal.Bool b ->
    TreeNode(string b)
  | Literal.Null ->
    TreeNode("Literal.null")

//let mapAstToTreeNode (ast:Program) (name:string) =
//    let rec mapProgramToTreeNodeInner (t:Program) (node : TreeNode) =
//        match t with
//        | x::[] ->
//            let newNode = new TreeNode(name)
//            node.Nodes.Add(newNode) |> ignore
//            mapProgramToTreeNodeInner l newNode
//            mapProgramToTreeNodeInner a newNode
//        | Leaf x ->
//            node.Nodes.Add(new TreeNode(sprintf "%A" x)) |> ignore
//    let root = new TreeNode(name)
//    mapProgramToTreeNodeInner t root
//    root
//
//
//// The tree type
//type 'n Tree =
//    | Node of 'n Tree * 'n Tree
//    | Leaf of 'n
//// The definition of the tree
//let tree =
//        Node(
//            Node(
//                Leaf "Even Numbers",
//                Node(Leaf "two", Leaf "three")),
//            Node(
//                Node(Leaf "six", Leaf "eight"),
//                Leaf "ten"))
//// A function to transform our tree into a tree of controls
//let mapTreeToTreeNode t =
//    let rec mapTreeToTreeNodeInner t (node : TreeNode) =
//        match t with
//        | Node (l, a) ->
//            let newNode = new TreeNode("Node")
//            node.Nodes.Add(newNode) |> ignore
//            mapTreeToTreeNodeInner l newNode
//            mapTreeToTreeNodeInner a newNode
//        | Leaf x ->
//            node.Nodes.Add(new TreeNode(sprintf "%A" x)) |> ignore
//    let root = new TreeNode("Root")
//    mapTreeToTreeNodeInner t root
//    root
//// create the form object
let showAst ast name =
  let form =
      let temp = new Form()
      do temp.Name <- name
      let treeView = new TreeView(Dock = DockStyle.Fill)
      treeView.Nodes.Add(ProgramToTreeNode ast name) |> ignore
      treeView.ExpandAll()
      temp.Controls.Add(treeView)
      temp
  Application.Run(form)